perm filename SPACER.F4[P11,LCS] blob sn#581880 filedate 1981-04-27 generic text, type T, neo UTF8
C***** SPACER,JDRAW,EXTEN,RTLINE,THICK,RBJX,CENTX,CENTER,LINX
C***** UNPACK,ROFF,NOZERO,RHORZ
	SUBROUTINE SPACER(J5,IFNT,RB,R)
C **** THIS IS FROM ALPHA.FAI
C  SPACES ALPHABET ITEMS.
	DATA RS/1.08/,RSPC/1./,RLWR/.96/,BLANK/0.7/
C  JUMP TO USE PRIMITIVE ALPHABET.
	IF(J5.GT.47)GO TO 10
	IF(J5.LE.9)GO TO 177
	IF(J5.LT.36)GO TO 10
C NEXT FOR NUMBERS, SPACE AND PUNCTUATION.
CZ177	RSX=BLANK
CZ	IF(IFNT)RSX=.9
177	RSX=1.0
	IF(J5.EQ.47)RSX=BLANK
	IF(IFNT.LT.0)RSX=.9
	IF(J5.NE.39)GO TO 3
C IF IT IS '=' THEN USE 1.2096
	RSX=1.2096
	GO TO 21
10	IF(J5.LT.47)GO TO 5
	IF(J5.EQ.52)GO TO 14
	IF(J5.GE.55)GO TO 5
C  PUNCT. WILL EXPAND ABOVE 54.
	RETURN
14	IFNT=0
C  #=52=PRIMITIVE
	JA=10
	RETURN
5	RSX=RS
	IF(IFNT.LT.0)RSX=RLWR
C  FOR LOWER CASE SPACING.  (96%)
	IF(J5.EQ.22.OR.J5.EQ.69.OR.J5.EQ.59.OR.J5.EQ.59)GO TO 277
C JUMP IF 1/8 NOTE OR 'M' OR 1/4 OR 1/2
	IF(J5.NE.32)GO TO 3
277	RSX=RSX*1.12
C  FOR M AND W
3	IF(J5.GE.36)GO TO 21
	IF(J5.EQ.1)GO TO 21
	IF(J5.EQ.18)GO TO 21
	IF(J5.EQ.19)GO TO 21
C  FOR 1,I AND J
	IF(IFNT.GE.0)GO TO 4
C  NEXT FOR LOWER CASE ONLY.
	IF(J5.EQ.15)GO TO 21
	IF(J5.EQ.19)GO TO 21
	IF(J5.EQ.21)GO TO 21
	IF(J5.NE.29)GO TO 4
21	IF(J5.NE.47)RSX=RSX*.68
C  FOR F,I,J,L,T
4	RB=RB+R*RSX
	END

C**** ALL FOLLOWING ARE FROM MFAIL.FAI
	SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
C USES DATA FROM DRW PROGRAM.
	COMMON/LL/L
	DIMENSION M(1)
	RC=RX*RSTJ2
	RD=RY*RSTJ2
	DO 2 K=2,M(1)
	CALL UNPACK(IA,IB,M(K))
2	CALL LINES(FLOAT(IA)*RC+R3,FLOAT(IB)*RD+CENTR,L)
	END

	SUBROUTINE CENTER(CNTR)
C  TO CENTER ITEMS CREATED WITH DRAWING PROG.
	COMMON /STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,POS
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	EQUIVALENCE (R4,RJQ(2))
	CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
	END

	SUBROUTINE LINX(A,B,C,D)
C  SAVES SPACE FOR SINGLE LINES.
	CALL LINES(A,B,3)
	CALL LINES(C,D,2)
	END

	SUBROUTINE UNPACK(M,N,I)
C UNPACKS VECTORS FROM DRW PROGRAM.
C EACH WD = N/AXXX/BYYY  IF N.NE.0 =INVIS. LINE.
C   IF A=1 THEN X IS NEG.  IF B=1, Y IS NEG.
	COMMON/LL/L
C  L IS FOR VIS. OR INVIS. LINES.
	N=I
	L=2
	M=N/100000000
	IF(M.EQ.0)GO TO 2
	L=3
	N=N-100000000*M
2	M=N/10000
	IF(M.GT.1000)M=1000-M
	N=MOD(N,10000)
	IF(N.GT.1000)N=1000-N
	END

	FUNCTION EXTEN(X)
	EXTEN=AMOD(X,1.0)*10.
	END

	FUNCTION ROFF(R)
C FOR ROUND OFF
	S=.5
	IF(R.LT.0)S=-S
	ROFF=R+S
	END

	SUBROUTINE NOZERO(X)
	IF(X.EQ.0)X=1.
	END

	SUBROUTINE EXCH(X,Y)
	Z=X
	X=Y
	Y=Z
	END

	FUNCTION RHORZ(R)
	RHORZ=R*5.96-596.
	END
C  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
CF	IPOS=ROFF(RJQ(1)*DIS)
CCCF	IF(RMINI.LT..9)IPOS=IPOS+1
CF	JPOS=ROFF(CENTR*RHT)
CF	IF(-RMINI.EQ.PRE)GO TO 10
CF	PRE=-RMINI
CCCF	D=.25*RMINI
CF	D=.25
CF	B=BH*RMINI*RHT
CF	E=RMINI*DIS
CF	A=BL*E
CF	IC=A
CF	A=A*A
CF	E=-B/4.
CF	K=B
CF	B=B*B
C  USES EQUATION FOR ELLIPSE
CF	N=1
CF	NX=2
CF6	DO 1 J=-K,K
CF	Y=J*J
CF	X=SQRT(A-(A*Y)/B)
CF	L=E-X
CF	M=X+E
C  THE TWO SIDES OF THE LINE
CF	IF(N)CALL EXCH(L,M)
CF	IRN(NX)=L
CF	IRN(NX+1)=M
C     C IS VERTICAL POS.
CF	NX=NX+2
CF	E=E+D
C   E IS TO TILT IT.
CF1	N=-N
CF10	CALL PLOT(IPOS+3,JPOS,3)
CF	N=2
C   1ST LOC. OF ARRAY HAS "PRE"
CF	L=IPOS+IC
CF	DO 11 M=-K,K
CF	J=M+JPOS
CF	CALL PLOT(L+IRN(N),J,2)
CF	CALL PLOT(L+IRN(N+1),J,2)
CF11	N=N+2
CF	END

	SUBROUTINE RJBX(R)
        COMMON R2,JA,CN,J2,R3/STF/RSTFAC(8),RSTJ2
	R3=R3+R*RSTJ2
	END

	SUBROUTINE CENTX
        COMMON R2,JA,CENTR,D,E,R4,R(38) /STF/RSTFAC(8),RSTJ2
	1 /POSI/STFF(8),JJ2,POS
	CENTR=AMOD(R4,100.0)
	IF(JA.EQ.8)GO TO 1
C STAFF CAN BE AT ANY LEVEL UP TO 99.9 + OR -
	CR=0
	IF(CENTR.LT.-80.)CR=100.
	IF(CENTR.GE.80.)CR=-100.
	R4=CENTR+CR
1	CENTR=POS+RSTJ2*((R4*7.)-18.)
	END
CC	CENTR=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
C******** THE ABOVE ARE NOW IN SMALL.FAI (3/75)

C****** 7, STF, POS, HGT, NUM OF SHARPS OR FLATS(+ OR -), CLEF
C		      (	CLEF = TREB,0  BASS,1  ALT,2  TEN,3 )
	FUNCTION RTLINE(L)
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(1)
C CHECKS TO SEEIF R2 HAS STAFF NUM DESIRED.  (IF >7, ALL STAVES OK)
	IF(R2.GT.7)GO TO 1
	IF(RN(L+2).NE.R2)GO TO 2
1       RTLINE=0
C RIGHT STAFF
	RETURN
2	RTLINE=-1
C WRONG STAFF
	END

	SUBROUTINE THICK
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	1 /STF/RS(8),RSTJ2 /PLTR/PLT,RHT,DIS,XDIS 
	EQUIVALENCE (R8,RJQ(6)),(J8,JQ(6)),(J9,JQ(7)),(J4,JQ(2))
C  RETURNS NUMBER OF THICKNESSES IN J8 AND "SCALED" STEP IN R8
C NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
	R8=AMOD(R8,100.0)
	J9=J8/100
	J8=R8
	J4=-1
C FLAG FOR SINGLE ADDED VERTICAL THICKNESS, NO MATTER WHAT SIZE. R8=.5
	IF(R8.NE.J8)J4=0
	R9=RSTJ2*DIS
C  R8 AND R9 ARE FACTORS TO CAUSE RIGHT NUM OF LINES FOR THICKNESS.
	J8=J8*R9
	J9=J9*R9
	IF(J9.NE.0.AND.J8.NE.0)J9=J8
C  IF BOTH X AND Y THICKNESS ARE USED THEY WILL BECOME EQUAL!
CC	IF(J4)GO TO 1 
	IF(J4.GE.0)J9=1
C SINGLE ADDED THICKNESS, NO MATTER WHAT SIZE.;	R8=1
	END